home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / pcpm.arc / CPACFA.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1985-06-04  |  7.8 KB  |  263 lines
  1. 100  REM **** CPACFA ****
  2. 110  CLOSE
  3. 120  DEFINT B-Z:DEFSNG A,Q
  4. 130  NM=24
  5. 140  DIM C2(500,NM),A(1500),S2(500),F2(500),C(500),H(500)
  6. 150  DIM X$(NM),Q(500),D$(500),A3(100)
  7. 160  P6=2
  8. 170  X$(1)=" JANUARY "
  9. 180  X$(2)="FEBRUARY "
  10. 190  X$(3)="  MARCH  "
  11. 200  X$(4)="  APRIL  "
  12. 210  X$(5)="   MAY   "
  13. 220  X$(6)="  JUNE   "
  14. 230  X$(7)="  JULY   "
  15. 240  X$(8)=" AUGUST  "
  16. 250  X$(9)="SEPTEMBER"
  17. 260  X$(10)=" OCTOBER "
  18. 270  X$(11)="NOVEMBER "
  19. 280  X$(12)="DECEMBER "
  20. 290  B4=VAL(MID$(DATE$,1,2))
  21. 300  B5=VAL(MID$(DATE$,4,2))
  22. 310  B6=VAL(MID$(DATE$,9,2))
  23. 320  GOSUB 1940 'READ INPUT FILE FOR COSTS AND P$
  24. 330  INPUT "Want Early or Late Projection (E/L)  ",Q$
  25. 340  IF LEFT$(Q$,1)="L" THEN F6=0 ELSE F6=1
  26. 350  GOSUB 2520 'READ LGS FILE FOR OTHER INFO
  27. 355  GOSUB 2420 'READ HOLIDAYS
  28. 360  PRINT "**** NOW FIGURING DAYS - WILL TAKE";INT(C3/6);"SECONDS IN REGULAR BASIC ****"
  29. 380  GOSUB 2150:PRINT "**** DAYS FIGURED - DISTRIBUTING COSTS AMONG MONTHS ****"
  30. 390  M=INT(A(L+1)/10000)                'LOWEST MONTH IN PRINTOUT
  31. 400  Y=A(L+1)-(INT(A(L+1)/100)*100)     'LOWEST YEAR
  32. 410  D=INT((A(L+1)-(M*10000)-Y)/100)    'LOWEST DAY
  33. 420  M1=INT(A(H+1)/10000)                'HIGHEST MONTH IN PRINTOUT
  34. 430  Y1=A(H+1)-(INT(A(H+1)/100)*100)     'HIGHEST YEAR
  35. 440  D1=INT((A(H+1)-(M1*10000)-Y1)/100)    'HIGHEST DAY
  36. 450  FOR I=1 TO 12
  37. 460  X$(12+I)=X$(I)
  38. 470  NEXT I
  39. 480  M4=(Y1-Y)*12+(M1-M)+1+1         '# OF MONTHS FROM BEGINNING TO END
  40. 490  Z=6                             '# OF MONTHS PER PRINTOUT SHEET
  41. 500  X1=INT(M4/Z)                       '# OF SEGMENTS 6=WIDTH-MONTHS
  42. 510  X2=INT((M4/Z-X1)*Z+0.1)              '# OF EXTRA MONTHS
  43. 520  FOR I=1 TO N
  44. 530  IF F2(I)<=S2(I) THEN C(I)=C(I) ELSE C(I)=C(I)/(F2(I)-S2(I))
  45. 540  J=S2(I)
  46. 550  K=1
  47. 560  M3=INT(A(J+1)/10000)              'MONTH
  48. 570  Y3=A(J+1)-INT(A(J+1)/100)*100          'YEAR
  49. 580  Y2=(Y3-Y)*12+(M3-M)+1             '# OF MONTH FROM BEGINNING
  50. 590  J=J+1
  51. 600  K=K+1
  52. 610  IF J>=F2(I) THEN 630
  53. 620  IF INT(A(J+1)/10000)=M3 THEN 590
  54. 630  C2(I,Y2)=C(I)*(K-1)
  55. 640  IF J>=F2(I) THEN 660
  56. 650  GOTO 550
  57. 660  NEXT I
  58. 670  FOR I=1 TO N
  59. 680  IF F2(I)<=S2(I) THEN C2(I,M4)=C(I) ELSE C2(I,M4)=C(I)*(F2(I)-S2(I))
  60. 690  NEXT I
  61. 700  FOR I=1 TO M4
  62. 710  H(I)=0
  63. 720  FOR J=1 TO N
  64. 730  H(I)=H(I)+C2(J,I)         'SUM MONTH TOTALS
  65. 740  NEXT J
  66. 750  IF I=1 THEN Q(I)=H(I) ELSE Q(I)=Q(I-1)+H(I)
  67. 760  IF I=M4 THEN Q(I)=Q(I-1)
  68. 770  NEXT I
  69. 780  PRINT "Name of output file is ";F$;".CFA";:INPUT " O.K. (Y/N) ";Q$
  70. 790  IF Q$="N" THEN INPUT "Enter new output filename ";F$
  71. 800  IF LEN(F$)>8 OR INSTR(1,F$,".")<>0 THEN BEEP:PRINT "**** NO EXTENSIONS PLEASE ****":GOTO 790
  72. 810  OPEN F$+".CFA" FOR OUTPUT AS #1
  73. 820  PRINT "Want to suppress zero-cost activities  (Y/N) ";
  74. 830  INPUT Q$
  75. 840  IF LEFT$(Q$,1)="N" THEN S8=0 ELSE S8=1
  76. 850  GOSUB 1810                      ' SETUP USAGES
  77. 870  PRINT "**** THINKING ";
  78. 880  PRINT #1,G8$  'FORM FEED
  79. 890  PRINT #1,"                        CASH FLOW ANALYSIS - PROJECTED CASH REQUIREMENTS BY MONTH AND ACTIVITY"
  80. 900  PRINT #1,G9$
  81. 910  T4=INT((116-LEN(P$))/2)
  82. 920  PRINT #1,TAB(T4);P$
  83. 930  PRINT #1,G9$
  84. 940  IF F6=1 THEN P1$="EARLY START - EARLY" ELSE P1$="LATE START - LATE"
  85. 950  P1$=P1$+" FINISH PROJECTION"
  86. 960  T5=INT((116-LEN(P1$))/2)
  87. 970  PRINT #1,TAB(T5);P1$
  88. 980  PRINT #1,G9$
  89. 990  PRINT #1,G9$
  90. 1000  PRINT #1, USING "                                              RUN DATE: \       \ ## 19## ";X$(B4),B5,B6
  91. 1010  PRINT #1, USING "                                         PROJECT START: \       \ ## 19## ";X$(M),D,Y
  92. 1020  PRINT #1, USING "                                            COMPLETION: \       \ ## 19## ";X$(M1),D1,Y1
  93. 1030  PRINT #1,G9$
  94. 1040  L=1-Z
  95. 1050  M=M-Z
  96. 1060  IF X1=0 THEN 1240
  97. 1070  FOR I=1 TO X1                     '# OF FULL SEGMENTS
  98. 1080  PRINT ".";
  99. 1090  IF I>1 THEN GOSUB 1880
  100. 1100  M=M+Z
  101. 1110  IF X2=0 AND I=X1 THEN X$(M+5)=S$    'IN CASE OF LAST MONTH
  102. 1120  PRINT #1, USING T$;X$(M),X$(M+1),X$(M+2),X$(M+3),X$(M+4),X$(M+5)
  103. 1130  L=L+Z
  104. 1140  PRINT #1,G9$
  105. 1150  FOR J=1 TO N
  106. 1160  IF S8=1 AND C2(J,M4)=0 THEN 1180
  107. 1170  PRINT #1, USING U$;D$(J),C2(J,L),C2(J,L+1),C2(J,L+2),C2(J,L+3),C2(J,L+4),C2(J,L+5)
  108. 1180  NEXT J
  109. 1190  PRINT #1,G9$
  110. 1200  PRINT #1, USING W$;H(L),H(L+1),H(L+2),H(L+3),H(L+4),H(L+5)
  111. 1210  PRINT #1,G9$
  112. 1220  PRINT #1, USING W1$;Q(L),Q(L+1),Q(L+2),Q(L+3),Q(L+4),Q(L+5)
  113. 1230  NEXT I
  114. 1240  IF X2=0 THEN PRINT " FINISHING ****":GOTO 1760
  115. 1250  I=I+1
  116. 1260  IF X1<>0 THEN GOSUB 1880
  117. 1270  M=M+Z
  118. 1280  L=L+Z
  119. 1290  ON X2 GOTO 1300,1320,1340,1360,1380
  120. 1300  PRINT #1, USING T$;S$
  121. 1310  GOTO 1390
  122. 1320  PRINT #1, USING T$;X$(M),S$
  123. 1330  GOTO 1390
  124. 1340  PRINT #1, USING T$;X$(M),X$(M+1),S$
  125. 1350  GOTO 1390
  126. 1360  PRINT #1, USING T$;X$(M),X$(M+1),X$(M+2),S$
  127. 1370  GOTO 1390
  128. 1380  PRINT #1, USING T$;X$(M),X$(M+1),X$(M+2),X$(M+3),S$
  129. 1390  PRINT #1,G9$
  130. 1400  PRINT " FINISHING ****"
  131. 1410  FOR J=1 TO N
  132. 1420  IF S8=1 AND C2(J,M4)=0 THEN 1530
  133. 1430  ON X2 GOTO 1440,1460,1480,1500,1520
  134. 1440  PRINT #1, USING U$;D$(J),C2(J,L)
  135. 1450  GOTO 1530
  136. 1460  PRINT #1, USING U$;D$(J),C2(J,L),C2(J,L+1)
  137. 1470  GOTO 1530
  138. 1480  PRINT #1, USING U$;D$(J),C2(J,L),C2(J,L+1),C2(J,L+2)
  139. 1490  GOTO 1530
  140. 1500  PRINT #1, USING U$;D$(J),C2(J,L),C2(J,L+1),C2(J,L+2),C2(J,L+3)
  141. 1510  GOTO 1530
  142. 1520  PRINT #1, USING U$;D$(J),C2(J,L),C2(J,L+1),C2(J,L+2),C2(J,L+3),C2(J,L+4)
  143. 1530  NEXT J
  144. 1540  PRINT #1,G9$
  145. 1550  ON X2 GOTO 1560,1580,1600,1620,1640
  146. 1560  PRINT #1, USING W$;H(L)
  147. 1570  GOTO 1650
  148. 1580  PRINT #1, USING W$;H(L),H(L+1)
  149. 1590  GOTO 1650
  150. 1600  PRINT #1, USING W$;H(L),H(L+1),H(L+2)
  151. 1610  GOTO 1650
  152. 1620  PRINT #1, USING W$;H(L),H(L+1),H(L+2),H(L+3)
  153. 1630  GOTO 1650
  154. 1640  PRINT #1, USING W$;H(L),H(L+1),H(L+2),H(L+3),H(L+4)
  155. 1650  PRINT #1,G9$
  156. 1660  ON X2 GOTO 1670,1690,1710,1730,1750
  157. 1670  PRINT #1, USING W1$;Q(L)
  158. 1680  GOTO 1760
  159. 1690  PRINT #1, USING W1$;Q(L),Q(L+1)
  160. 1700  GOTO 1760
  161. 1710  PRINT #1, USING W1$;Q(L),Q(L+1),Q(L+2)
  162. 1720  GOTO 1760
  163. 1730  PRINT #1, USING W1$;Q(L),Q(L+1),Q(L+2),Q(L+3)
  164. 1740  GOTO 1760
  165. 1750  PRINT #1, USING W1$;Q(L),Q(L+1),Q(L+2),Q(L+3),Q(L+4)
  166. 1760  IF S8=1 THEN PRINT #1,G9$
  167. 1770  IF S8=1 THEN PRINT #1,"    NOTE: ZERO-COST ACTIVITIES ARE SUPPRESSED"
  168. 1780  CLOSE #1
  169. 1790  PRINT "**** ";F$;".CFA CREATED ****"
  170. 1800  CHAIN "CPAMENU"
  171. 1810  REM **** USAGES FOR PRINTOUT ****
  172. 1820  S$="  TOTAL  "
  173. 1830  T$="                                     \       \    \       \    \       \    \       \    \       \    \       \"
  174. 1840  U$=" \                               \ ###########  ###########  ###########  ###########  ###########  ###########"
  175. 1850  W$="        TOTAL MONTHLY PROJECTION = ###########  ###########  ###########  ###########  ###########  ###########"
  176. 1860  W1$="           CUMULATIVE PROJECTION = ###########  ###########  ###########  ###########  ###########  ###########"
  177. 1870  RETURN
  178. 1880  REM **** PAGE HEADER FOR NEW SECTION ****
  179. 1890  PRINT #1,G8$ 'FORM FEED
  180. 1900  PRINT #1,TAB(T4);P$;TAB(116);"SECTION";P6
  181. 1910  P6=P6+1
  182. 1920  PRINT #1,G9$
  183. 1930  RETURN
  184. 1940  REM **** READING IN ALREADY CREATED INPUT FILE ******************
  185. 1950  INPUT "Enter the name of the input file [.CPM] ";G$
  186. 1960  IF G$="Q" OR G$="QUIT" THEN 1780
  187. 1970  P=INSTR(1,G$,"."):IF P<>0 THEN F$=LEFT$(G$,INSTR(1,G$,".")-1) ELSE F$=G$
  188. 1980  IF LEN(F$)>8 THEN PRINT "**** NOT A VALID PCPM FILE ****":BEEP:GOTO 1950
  189. 1990  ON ERROR GOTO 2140
  190. 2000  G$=F$+".CPM"
  191. 2010  OPEN G$ FOR INPUT AS #3
  192. 2020  INPUT #3,P$,T6$,DA$
  193. 2030  I=0
  194. 2040  I=I+1
  195. 2050  IF EOF(3) THEN 2090
  196. 2060  INPUT #3,D$,S,F,O2,D,A6,P,B,C(I)
  197. 2070  IF I/10=INT(I/10) THEN PRINT I;
  198. 2080  GOTO 2040
  199. 2090  N=I-1
  200. 2100  M6=VAL(LEFT$(DA$,2)):D6=VAL(MID$(DA$,3,2)):Y6=VAL(RIGHT$(DA$,2))
  201. 2110  CLOSE #3
  202. 2120  PRINT " **** INPUT FILE READ ****"
  203. 2130  RETURN
  204. 2140  PRINT "**** FILE DOES NOT EXIST - TRY AGAIN ****":BEEP:GOTO 1940
  205. 2150  REM ** CREATE ARRAY OF MMDDYYS ******************************
  206. 2160  D1=D1+1
  207. 2170  IF D1>C3+1 THEN RETURN
  208. 2180  A8=A8+1
  209. 2190  GOSUB 2270
  210. 2200  IF LEFT$(T6$,3)="CAL" THEN 2210 ELSE IF D4=6 OR D4=7 THEN 2180
  211. 2210  O8=0
  212. 2220  GOSUB 2380
  213. 2230  IF O8=1 THEN 2180
  214. 2240  A(D1)=M5*10000+D5*100+Y5
  215. 2250  GOTO 2160
  216. 2260  REM ** CONVERT CENTURY DAY TO MM, DD, YY **************************
  217. 2270  T9=INT(A8/1461)
  218. 2280  Y5=INT((A8-T9+364)/365)
  219. 2290  Y4=A8-INT((Y5-1)*1461/4)
  220. 2300  L8=2
  221. 2310  IF Y5/4=INT(Y5/4) THEN L8=1
  222. 2320  T9=Y4
  223. 2330  IF T9>61-L8 THEN T9=T9+L8
  224. 2340  M5=INT((T9*9+269)/275)
  225. 2350  D5=T9-INT(M5*275/9)+30
  226. 2360  D4=A8-INT(A8/7)*7+1
  227. 2370  RETURN
  228. 2380  FOR J=1 TO H9   '**** HOLIDAY OR NOT ***********************************
  229. 2390  IF A8=A3(J) THEN O8=1
  230. 2400  NEXT J
  231. 2410  RETURN
  232. 2420  ON ERROR GOTO 2510
  233. 2430  OPEN F$+".HOL" FOR INPUT AS #1
  234. 2440  J=0
  235. 2450  J=J+1
  236. 2460  IF EOF(1) THEN 2490
  237. 2470  INPUT #1,A3(J)
  238. 2480  GOTO 2450
  239. 2490  H9=J-1  'NUMBER OF HOLIDAYS
  240. 2500  CLOSE #1:RETURN
  241. 2510  PRINT "**** NO HOLIDAY FILE - CONTINUING ****":RESUME 2500
  242. 2520  REM READING IN SORT FILE
  243. 2530  ON ERROR GOTO 2720    'NO SORT FILE
  244. 2540  OPEN F$+".LGS" FOR INPUT AS #1
  245. 2550  INPUT #1,A8,A(1),C3
  246. 2560  I=0
  247. 2570  L=5000:H=0
  248. 2580  I=I+1
  249. 2590  IF EOF(1) THEN 2680
  250. 2600  IF I MOD 10=0 THEN PRINT I;
  251. 2610  IF F6=1 THEN 2640
  252. 2620  INPUT #1,D$(I),S,F,O2,D,ES,S2(I),EF,F2(I),RF,P,B
  253. 2630  GOTO 2650
  254. 2640  INPUT #1,D$(I),S,F,O2,D,S2(I),LS,F2(I),LF,RF,P,B
  255. 2650  IF S2(I)<L THEN L=S2(I)
  256. 2660  IF F2(I)>H THEN H=F2(I)
  257. 2670  GOTO 2580
  258. 2680  NACT=I-1:IF NACT<>N THEN BEEP:PRINT "**** NUMBER OF ACTIVITIES IN FILES DOESNT MATCH";NACT;N;"****":GOTO 1800
  259. 2690  PRINT "**** LGS FILE READ ****"
  260. 2700  CLOSE #1
  261. 2710  RETURN
  262. 2720  PRINT "FILE ";F$;".LGS MUST BE CREATED BY OPTION 5 FIRST AND EXIST ON DISK****":BEEP:CLOSE #1:CHAIN "CPAMENU"
  263.